; ORIGINAL: 3dt2.1/examples/block.scm
; $Id: block.scm,v 1.5 1998/09/29 16:06:40 jmb Exp $
; ---------------------------------------------------------------------
;    File: BLOCK.SCM
;   Notes: Rubberbands a solid block.
;
;   Usage: (block)
;  Action: pick the base rectangle start point
;          rubberband the base rectangle
;          pick the base rectangle end point
;          rubberband the solid block
; ---------------------------------------------------------------------

(define block (lambda ()
    (let* ((base_start_pos (pick:position (read-ray)))
           (curr_view #f)

           ;; Define a vector to contain the vertex positions.  We
           ;; store a closed polygon for the base and top rectangles.
           (points (make-vector 10 (position 0 0 0)))

           ;; Define a procedure to compute the top vertices from the
           ;; base vertices.
           (compute (lambda (pos)
               (let
                    ;; Get the direction vector from the base. The result
                    ;; is either a + or - z axis vector with magnitude.
                    ((delta (gvector:from-to (vector-ref points 2) pos)))

                   ;; offset the base rectangle the delta vector
                   (do ((i 0 (+ i 1))) ((= i 5))
                       (vector-set! points (+ i 5)
                           (position:offset (vector-ref points i) delta))
                       )
                   )
               ))

           ;; define a procedure to draw/undraw the rubberband block
           (draw (lambda ()
               (if curr_view
                   (begin
                   (view:set-rb-mode #t curr_view)
                   ;; draw both rectangles (this gives us one
                   ;; connecting line)
                   (view:draw-polyline points curr_view)
                   ;; draw remaining connecting lines
                   (view:draw-polyline (list (vector-ref points 1)
                       (vector-ref points 6)) curr_view)
                   (view:draw-polyline (list (vector-ref points 2)
                       (vector-ref points 7)) curr_view)
                   (view:draw-polyline (list (vector-ref points 3)
                       (vector-ref points 8)) curr_view)
                   (view:set-rb-mode #f curr_view)
                   ))
               ))

          ;; set rubberbanding hooks
          (rb_hooks (make-vector 7)))

        (begin
        ;; rubberband a rectangle for the base of the block
        (rbd:rectangle #t base_start_pos)

        (let* ((base_end_pos (pick:position (read-ray)))

               ;; map a pick event to a point on the block
               (get-position (lambda (pe)
                   ;; next, project position to z axis
                   (position:project-to-line
                       ;; first, hold pick to xz plane
                       (pick:position pe base_end_pos (wcs:y-axis))
                       base_end_pos (wcs:z-axis))
                   )))

            (begin
            ;; stop rectangle rubberbanding, this removes the
            ;; rubberbanded rectangle from the display
            (rbd:remove-type rbd:rectangle?)

            ;; set rubberband vectors
            (vector-set! rb_hooks 0 (lambda (self)      ;; INIT
                    (display "init\n")
                    ))
            (vector-set! rb_hooks 1 (lambda (self pe)   ;; START
                    (display "start\n")
                    (set! curr_view (event:view pe))
                    (compute (get-position pe))
                    (draw)
                    ))
            (vector-set! rb_hooks 2 (lambda (self pe)   ;; UPDATE
                    (display "update\n")
                    (if curr_view
                        (begin
                        (draw)
                        (compute (get-position pe))
                        (draw)
                        ))
                    ))
            (vector-set! rb_hooks 3 (lambda (self)      ;; STOP
                    (display "stop\n")
                    (draw)
                    ))
            (vector-set! rb_hooks 4 (lambda (self v)    ;; REPAINT
                    (display "repaint\n")
                    (if (equal? v curr_view)
                        (draw)
                        )
                    ))
            (vector-set! rb_hooks 5 (lambda (self pe)   ;; POSITION
                    (display "position\n")
                    ))
            (vector-set! rb_hooks 6 (lambda (self)      ;; END
                    (display "end\n")
                    (set! curr_view #f)
                    ))

            ;; store the base rectangle
            (vector-set! points 0 (position:copy base_start_pos))
            (vector-set! points 1 (position:project-to-line
                base_end_pos base_start_pos (wcs:x-axis)))
            (vector-set! points 2 (position:copy base_end_pos))
            (vector-set! points 3 (position:project-to-line
                base_end_pos base_start_pos (wcs:y-axis)))
            (vector-set! points 4 (position:copy base_start_pos))

            ;; start rubberbanding the block
            (rbd:scheme #t rb_hooks)

            (let ((stop_pos (get-position (read-ray))))
                (begin
                ;; stop rubberbanding
                (rbd:remove-type rbd:scheme?)

                ;; create block
                (solid:block base_start_pos stop_pos)
                ))

            )) ;; begin/let

        )) ;; begin/let

)) ;; lambda/define

; ----------------------------------
;  End of BLOCK.SCM
; ----------------------------------
